home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / prog / svgapv20.arj / SVGAMOD2.BAS < prev    next >
BASIC Source File  |  1994-03-11  |  39KB  |  1,229 lines
  1. '****************************************************************************
  2. '*
  3. '*      'SVGAQB' & 'SVGAPV' A Super VGA Graphics Librarys for use with
  4. '*      MS QuickBASIC 4.X and MS PDS/VBDOS
  5. '*      Copyright 1993-1994 by Stephen L. Balkum and Daniel A. Sill
  6. '*
  7. '*      MS, QuickBASIC, PDS, and VBDOS are registered trademarks of
  8. '*      Microsoft Corporation. GIF and 'Graphics Interchange Format' are
  9. '*      trademarks (TM) ofCompuServe, Incorporated, an H&R Block Company.
  10. '*
  11. '*    **************** UNREGISTERED SHAREWARE VERSION **********************
  12. '*    * FOR EVALUATION ONLY. NOT FOR RESALE IN ANY FORM. SOFTWARE WRITTEN  *
  13. '*    * USING THIS UNREGISTERED SHAREWARE GRAPHICS LIBRARY MAY NOT BY SOLD *
  14. '*    * OR USED FOR ANY PURPOSE OTHER THAN THE EVALUATION OF THIS LIBRARY. *
  15. '*    **********************************************************************
  16. '*
  17. '*    **************** NO WARRANTIES AND NO LIABILITY **********************
  18. '*    * Stephen L. Balkum and Daniel A. Sill provide no warranties, either *
  19. '*    * expressed or implied, of merchant ability, or fitness, for a       *
  20. '*    * particular use or purpose of this SOFTWARE and documentation.      *
  21. '*    * In no event shall Stephen L. Balkum or Daniel A. Sill be held      *
  22. '*    * liable for any damages resulting from the use or misuse of the     *
  23. '*    * SOFTWARE and documentation.                                        *
  24. '*    **********************************************************************
  25. '*
  26. '*    ************** U.S. GOVERNMENT RESTRICTED RIGHTS *********************
  27. '*    * Use, duplication, or disclosure of the SOFTWARE and documentation  *
  28. '*    * by the U.S. Government is subject to the restrictions as set forth *
  29. '*    * in subparagraph (c)(1)(ii) of the Rights in Technical Data and     *
  30. '*    * Computer Software clause at DFARS 252.227-7013.                    *
  31. '*    * Contractor/manufacturer is Stephen L. Balkum and Daniel A. Sill,   *
  32. '*    * P.O. Box 7704, Austin, Texas 78713-7704                            *
  33. '*    **********************************************************************
  34. '*
  35. '*    **********************************************************************
  36. '*    * By using this SOFTWARE or documentation, you agree to the above    *
  37. '*    * terms and conditions.                                              *
  38. '*    **********************************************************************
  39. '*
  40. '****************************************************************************
  41.  
  42.  
  43.     REM $INCLUDE: 'SVGABC.BI'
  44.     REM $INCLUDE: 'SVGADEMO.BI'
  45.  
  46. REM $DYNAMIC
  47.     SUB DO2D (RET$)
  48.  
  49.  
  50.     DIM POINTARRY(0 TO 8) AS P2DType
  51.  
  52.     '*************************************************************************
  53.     '* SET UP THE TITLE
  54.     '*************************************************************************
  55.     TITLE$ = "DEMO 11: 2D functions"
  56.     PALSET PAL, 0, 255
  57.  
  58.     '*************************************************************************
  59.     '* SET UP THE 'STAR' PATTERN OF POINTS
  60.     '*************************************************************************
  61.     SETVIEW 0, 0, GETMAXX, GETMAXY
  62.     CNTX = GETMAXX \ 2
  63.     CNTY = ((GETMAXY - 32) \ 2) + 32
  64.     SPCNG = GETMAXX \ 30
  65.     POINTARRY(0).X = 0
  66.     POINTARRY(0).Y = -SPCNG * 6
  67.     POINTARRY(1).X = SPCNG * 2
  68.     POINTARRY(1).Y = -SPCNG * 2
  69.     POINTARRY(2).X = SPCNG * 6
  70.     POINTARRY(2).Y = 0
  71.     POINTARRY(3).X = SPCNG * 2
  72.     POINTARRY(3).Y = SPCNG * 2
  73.     POINTARRY(4).X = 0
  74.     POINTARRY(4).Y = SPCNG * 6
  75.     POINTARRY(5).X = -SPCNG * 2
  76.     POINTARRY(5).Y = SPCNG * 2
  77.     POINTARRY(6).X = -SPCNG * 6
  78.     POINTARRY(6).Y = 0
  79.     POINTARRY(7).X = -SPCNG * 2
  80.     POINTARRY(7).Y = -SPCNG * 2
  81.     POINTARRY(8).X = 0
  82.     POINTARRY(8).Y = -SPCNG * 6
  83.  
  84.     '*************************************************************************
  85.     '* SHOW D2TRANSLATE
  86.     '*************************************************************************
  87.     FILLSCREEN (0)
  88.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  89.     A$ = "D2TRANSLATE (Points,XTrans,YTrans,InAry,OutAry)"
  90.     DRWSTRING 1, 7, 0, A$, 10, 16
  91.     SETVIEW 0, 32, GETMAXX, GETMAXY
  92.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  93.     SHOWSTAR
  94.     GETKEY RET$
  95.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  96.         FILLSCREEN (0)
  97.         SETVIEW 0, 0, GETMAXX, GETMAXY
  98.         EXIT SUB
  99.     END IF
  100.     XTRANS = 0
  101.     YTRANS = 0
  102.     FOR J = 0 TO SPCNG * 2
  103.         XTRANS = XTRANS + 2
  104.         YTRANS = YTRANS + 2
  105.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  106.         SHOWSTAR
  107.         SDELAY 2
  108.     NEXT J
  109.     FOR J = 0 TO SPCNG * 2
  110.         XTRANS = XTRANS - 2
  111.         YTRANS = YTRANS - 2
  112.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  113.         SHOWSTAR
  114.         SDELAY 2
  115.     NEXT J
  116.     GETKEY RET$
  117.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  118.         FILLSCREEN (0)
  119.         SETVIEW 0, 0, GETMAXX, GETMAXY
  120.         EXIT SUB
  121.     END IF
  122.  
  123.     '*************************************************************************
  124.     '* SHOW D2SCALE
  125.     '*************************************************************************
  126.     SETVIEW 0, 0, GETMAXX, 31
  127.     FILLVIEW (0)
  128.     SETVIEW 0, 0, GETMAXX, GETMAXY
  129.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  130.     A$ = "D2SCALE (Points,XScale,YScale,InAry,OutAry)"
  131.     DRWSTRING 1, 7, 0, A$, 10, 16
  132.     SETVIEW 0, 32, GETMAXX, GETMAXY
  133.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  134.     SHOWSTAR
  135.     FOR J = 256 TO 380 STEP 4
  136.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  137.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  138.         SHOWSTAR
  139.         SDELAY 2
  140.         NEXT J
  141.     X = J
  142.     FOR J = X TO 256 STEP -4
  143.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  144.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  145.         SHOWSTAR
  146.         SDELAY 2
  147.     NEXT J
  148.     X = J
  149.     FOR J = X TO 128 STEP -4
  150.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  151.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  152.         SHOWSTAR
  153.         SDELAY 2
  154.     NEXT J
  155.     X = J
  156.     FOR J = X TO 256 STEP 4
  157.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  158.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  159.         SHOWSTAR
  160.         SDELAY 2
  161.     NEXT J
  162.     GETKEY RET$
  163.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  164.         FILLSCREEN (0)
  165.         SETVIEW 0, 0, GETMAXX, GETMAXY
  166.         EXIT SUB
  167.     END IF
  168.  
  169.     '*************************************************************************
  170.     '* SHOW D2ROTATE (ABOUT THE CENTER OF THE OBJECT)
  171.     '*************************************************************************
  172.     SETVIEW 0, 0, GETMAXX, 31
  173.     FILLVIEW (0)
  174.     SETVIEW 0, 0, GETMAXX, GETMAXY
  175.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  176.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  177.     DRWSTRING 1, 7, 0, A$, 10, 16
  178.     A$ = "Lets do it about the center of the object."
  179.     DRWSTRING 1, 7, 0, A$, 10, 32
  180.     SETVIEW 0, 32, GETMAXX, GETMAXY
  181.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  182.     SHOWSTAR
  183.     FOR J = 0 TO 180
  184.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  185.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  186.         SHOWSTAR
  187.         SDELAY 2
  188.     NEXT J
  189.     FOR J = 180 TO 0 STEP -2
  190.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  191.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  192.         SHOWSTAR
  193.         SDELAY 2
  194.     NEXT J
  195.     GETKEY RET$
  196.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  197.         FILLSCREEN (0)
  198.         SETVIEW 0, 0, GETMAXX, GETMAXY
  199.         EXIT SUB
  200.     END IF
  201.  
  202.     '*************************************************************************
  203.     '* SHOW D2ROTATE (ABOUT AN ARBITRARY POINT)
  204.     '*************************************************************************
  205.     SETVIEW 0, 0, GETMAXX, 48
  206.     FILLVIEW (0)
  207.     SETVIEW 0, 0, GETMAXX, GETMAXY
  208.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  209.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  210.     DRWSTRING 1, 7, 0, A$, 10, 16
  211.     A$ = "Lets do it about an arbitrary point."
  212.     DRWSTRING 1, 7, 0, A$, 10, 32
  213.     SETVIEW 0, 32, GETMAXX, GETMAXY
  214.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  215.     SHOWSTAR
  216.     FOR J = 0 TO 360 STEP 2
  217.         D2ROTATE 9, 0, SPCNG * 6, J, POINTARRY(0).X, PLOTARRY(0).X
  218.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  219.         SHOWSTAR
  220.         SDELAY 2
  221.     NEXT J
  222.     SETVIEW 0, 0, GETMAXX, GETMAXY
  223.     GETKEY RET$
  224.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  225.         FILLSCREEN (0)
  226.         EXIT SUB
  227.     END IF
  228.  
  229.     END SUB
  230.  
  231.     SUB DO3D (RET$)
  232.  
  233.  
  234.  
  235.  
  236.     '*************************************************************************
  237.     '* SET UP THE TITLE
  238.     '*************************************************************************
  239.     TITLE$ = "DEMO 12: 3D functions"
  240.     PALSET PAL, 0, 255
  241.  
  242.     '*************************************************************************
  243.     '* SET UP THE 'HOUSE' PATTERN OF POINTS
  244.     '*************************************************************************
  245.     SETVIEW 0, 0, GETMAXX, GETMAXY
  246.     CNTX = GETMAXX \ 2
  247.     CNTY = ((GETMAXY - 32) \ 2) + 32
  248.     CNTZ = 0
  249.     SPCNG = GETMAXX \ 6
  250.     POINTARRY3D(0).X = -SPCNG
  251.     POINTARRY3D(0).Y = -SPCNG * 2
  252.     POINTARRY3D(0).Z = 0
  253.     POINTARRY3D(1).X = SPCNG
  254.     POINTARRY3D(1).Y = -SPCNG * 2
  255.     POINTARRY3D(1).Z = 0
  256.     POINTARRY3D(2).X = SPCNG
  257.     POINTARRY3D(2).Y = -SPCNG * 2
  258.     POINTARRY3D(2).Z = SPCNG * 2
  259.     POINTARRY3D(3).X = -SPCNG
  260.     POINTARRY3D(3).Y = -SPCNG * 2
  261.     POINTARRY3D(3).Z = SPCNG * 2
  262.     POINTARRY3D(4).X = -SPCNG
  263.     POINTARRY3D(4).Y = SPCNG * 2
  264.     POINTARRY3D(4).Z = 0
  265.     POINTARRY3D(5).X = SPCNG
  266.     POINTARRY3D(5).Y = SPCNG * 2
  267.     POINTARRY3D(5).Z = 0
  268.     POINTARRY3D(6).X = SPCNG
  269.     POINTARRY3D(6).Y = SPCNG * 2
  270.     POINTARRY3D(6).Z = SPCNG * 2
  271.     POINTARRY3D(7).X = -SPCNG
  272.     POINTARRY3D(7).Y = SPCNG * 2
  273.     POINTARRY3D(7).Z = SPCNG * 2
  274.     POINTARRY3D(8).X = 0
  275.     POINTARRY3D(8).Y = -SPCNG * 2
  276.     POINTARRY3D(8).Z = SPCNG * 3
  277.     POINTARRY3D(9).X = 0
  278.     POINTARRY3D(9).Y = SPCNG * 2
  279.     POINTARRY3D(9).Z = SPCNG * 3
  280.     POINTARRY3D(10).X = 0
  281.     POINTARRY3D(10).Z = 0
  282.     POINTARRY3D(10).Y = 0
  283.     POINTARRY3D(11).X = SPCNG * 4
  284.     POINTARRY3D(11).Z = 0
  285.     POINTARRY3D(11).Y = 0
  286.     POINTARRY3D(12).X = 0
  287.     POINTARRY3D(12).Z = 0
  288.     POINTARRY3D(12).Y = SPCNG * 4
  289.     POINTARRY3D(13).X = 0
  290.     POINTARRY3D(13).Z = SPCNG * 4
  291.     POINTARRY3D(13).Y = 0
  292.  
  293.     '*************************************************************************
  294.     '* SHOW D3PROJECT
  295.     '*************************************************************************
  296.     PI! = 4 * ATN(1) / 180
  297.     FILLSCREEN (0)
  298.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  299.     A$ = "D3PROJECT (Points,ProjParams,InAry,OutAry)"
  300.     DRWSTRING 1, 7, 0, A$, 10, 16
  301.     SETVIEW 0, 32, GETMAXX, GETMAXY
  302.     HEIGHT = GETMAXY * 8
  303.     Radius = GETMAXX * 30
  304.     J = 110
  305.     PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  306.     PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  307.     PROJ.EYEZ = HEIGHT
  308.     PROJ.SCRD = ((Radius ^ 2 + HEIGHT ^ 2) ^ .5) \ 2
  309.     PROJ.THETA = J
  310.     PROJ.PHI = CINT(ATN(HEIGHT / -Radius) / PI!)
  311.     BYTECOPY POINTARRY3D(0).X, PLAYARRY(0).X, 84
  312.     R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  313.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  314.     SHOWHOUSE
  315.     GETKEY RET$
  316.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  317.         FILLSCREEN (0)
  318.         SETVIEW 0, 0, GETMAXX, GETMAXY
  319.         EXIT SUB
  320.     END IF
  321.     FOR J = 112 TO 470 STEP 3
  322.         PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  323.         PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  324.         PROJ.THETA = J
  325.         R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  326.         SHOWHOUSE
  327.         SDELAY 2
  328.     NEXT J
  329.     GETKEY RET$
  330.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  331.         FILLSCREEN (0)
  332.         SETVIEW 0, 0, GETMAXX, GETMAXY
  333.         EXIT SUB
  334.     END IF
  335.  
  336.     '*************************************************************************
  337.     '* SHOW D3TRANSLATE
  338.     '*************************************************************************
  339.     SETVIEW 0, 0, GETMAXX, 31
  340.     FILLVIEW (0)
  341.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  342.     A$ = "D3TRANSLATE (Points,XTrans,YTrans,ZTrans,InAry,OutAry)"
  343.     DRWSTRING 1, 7, 0, A$, 10, 16
  344.     SETVIEW 0, 32, GETMAXX, GETMAXY
  345.     FOR J = 2 TO 300 STEP 6
  346.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  347.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  348.         SHOWHOUSE
  349.         SDELAY 2
  350.     NEXT J
  351.     X = J
  352.     FOR J = X TO 2 STEP -6
  353.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  354.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  355.         SHOWHOUSE
  356.         SDELAY 2
  357.     NEXT J
  358.     GETKEY RET$
  359.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  360.         FILLSCREEN (0)
  361.         SETVIEW 0, 0, GETMAXX, GETMAXY
  362.         EXIT SUB
  363.     END IF
  364.  
  365.     '*************************************************************************
  366.     '* SHOW D3SCALE
  367.     '*************************************************************************
  368.     SETVIEW 0, 0, GETMAXX, 31
  369.     FILLVIEW (0)
  370.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  371.     A$ = "D3SCALE (Points,XScale,YScale,ZScale,InAry,OutAry)"
  372.     DRWSTRING 1, 7, 0, A$, 10, 16
  373.     SETVIEW 0, 32, GETMAXX, GETMAXY
  374.     FOR J = 256 TO 380 STEP 4
  375.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  376.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  377.         SHOWHOUSE
  378.         SDELAY 2
  379.         NEXT J
  380.     X = J
  381.     FOR J = X TO 256 STEP -4
  382.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  383.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  384.         SHOWHOUSE
  385.         SDELAY 2
  386.     NEXT J
  387.     X = J
  388.     FOR J = X TO 128 STEP -4
  389.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  390.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  391.         SHOWHOUSE
  392.         SDELAY 2
  393.     NEXT J
  394.     X = J
  395.     FOR J = X TO 256 STEP 4
  396.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  397.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  398.         SHOWHOUSE
  399.         SDELAY 2
  400.     NEXT J
  401.     GETKEY RET$
  402.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  403.         FILLSCREEN (0)
  404.         SETVIEW 0, 0, GETMAXX, GETMAXY
  405.         EXIT SUB
  406.     END IF
  407.  
  408.     '*************************************************************************
  409.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  410.     '*************************************************************************
  411.     SETVIEW 0, 0, GETMAXX, 31
  412.     FILLVIEW (0)
  413.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  414.     A$ = "D3ROTATE (Points,XOrigin,YOrigin,ZOrigin,ZAngle,YAngle,XAngle,InAry,OutAry) "
  415.     DRWSTRING 1, 7, 0, A$, 10, 16
  416.     A$ = "Lets do it about the origin."
  417.     DRWSTRING 1, 7, 0, A$, 10, 32
  418.     SETVIEW 0, 32, GETMAXX, GETMAXY
  419.     FOR J = 0 TO 360 STEP 3
  420.         D3ROTATE 10, 0, 0, 0, 0, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  421.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  422.         SHOWHOUSE
  423.         SDELAY 2
  424.     NEXT J
  425.     GETKEY RET$
  426.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  427.         FILLSCREEN (0)
  428.         SETVIEW 0, 0, GETMAXX, GETMAXY
  429.         EXIT SUB
  430.     END IF
  431.  
  432.  
  433.  
  434.     END SUB
  435.  
  436.     SUB DOGIF (RET$)
  437.  
  438.     '*************************************************************************
  439.     '* SET UP THE TITLE
  440.     '*************************************************************************
  441.     TITLE$ = "DEMO 8: GIF functions"
  442.  
  443.     '*************************************************************************
  444.     '* SHOW GIF GET INFO
  445.     '*************************************************************************
  446.     SETVIEW 0, 0, GETMAXX, GETMAXY
  447.     FILLSCREEN (0)
  448.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  449.  
  450. LP:
  451.  
  452.     A$ = "Please provide the name and full path (if not in the current drive/directory)"
  453.     B$ = "of a GIF file you would like to see..."
  454.     C$ = "Filename:"
  455.     DRWSTRING 1, 7, 0, A$, 10, 64
  456.     DRWSTRING 1, 7, 0, B$, 10, 80
  457.     DRWSTRING 1, 7, 0, C$, 10, 96
  458.  
  459.     FILENAME$ = "_"
  460.     LENGTH = 0
  461.     EXT = 0
  462.  
  463.     WHILE EXT = 0
  464.         DRWSTRING 1, 15, 0, FILENAME$, 82, 96
  465.         A$ = ""
  466.         WHILE LEN(A$) < 1 OR LEN(A$) > 1
  467.             A$ = INKEY$
  468.         WEND
  469.         A = ASC(A$)
  470.         IF A > 31 AND A < 128 THEN
  471.             FILENAME$ = LEFT$(FILENAME$, LENGTH) + A$ + "_"
  472.             LENGTH = LENGTH + 1
  473.         ELSE
  474.             IF A = 8 AND LENGTH > 0 THEN
  475.                 DRWSTRING 1, 15, 0, STRING$(LENGTH + 1, 32), 82, 96
  476.                 LENGTH = LENGTH - 1
  477.                 FILENAME$ = LEFT$(FILENAME$, LENGTH) + "_"
  478.             ELSEIF A = 13 THEN
  479.                 EXT = 1
  480.             END IF
  481.         END IF
  482.     WEND
  483.     FILENAME$ = LEFT$(FILENAME$, LENGTH)
  484.     IF LEN(FILENAME$) < 1 THEN
  485.         EXIT SUB '* OOPS! NO NAME GIVEN SO LET'S JUST BAIL OUT!
  486.     END IF
  487.     SHOWGIF RET$, FILENAME$
  488.     IF RET$ = "S" OR RET$ = "Q" THEN
  489.         FILLSCREEN (0)
  490.         EXIT SUB
  491.     END IF
  492.  
  493.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  494.     A$ = "Would you like to see another (Y/N) ?"
  495.     DRWSTRING 1, 7, 0, A$, 10, 64
  496.     EXT = 0
  497.     SOUND 700, .75
  498.     WHILE EXT = 0
  499.         A$ = ""
  500.         WHILE A$ = ""
  501.             A$ = INKEY$
  502.         WEND
  503.         IF A$ = "Y" OR A$ = "y" THEN
  504.             GOTO LP
  505.         ELSEIF A$ = "N" OR A$ = "n" THEN
  506.             EXT = 1
  507.         ELSE
  508.             SOUND 100, 5
  509.         END IF
  510.     WEND
  511.     FILLSCREEN (0)
  512.  
  513.     END SUB
  514.  
  515.     SUB DOJOYSTICK (RET$)
  516.  
  517.     '*************************************************************************
  518.     '* SET UP THE TITLE
  519.     '*************************************************************************
  520.     TITLE$ = "DEMO 10: Joystick functions"
  521.     PALSET PAL, 0, 255
  522.     FILLSCREEN (0)
  523.     SETVIEW 0, 0, GETMAXX, GETMAXY
  524.  
  525.     '*************************************************************************
  526.     '* CHECK TO SEE IF WE HAVE A JOYSTICK SO WE CAN DO THE JOYSTICK DEMO
  527.     '*************************************************************************
  528.     JOYSTICK = WHICHJOYSTICK
  529.     IF JOYSTICK < 1 THEN
  530.         SOUND 100, 5
  531.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  532.         A$ = "Sorry, No Joystick Detected...Can Not Do The Joystick Demo."
  533.         DRWSTRING 1, 7, 0, A$, 10, 16
  534.         WHILE INKEY$ = ""
  535.         WEND
  536.         FILLSCREEN (0)
  537.         EXIT SUB
  538.     END IF
  539.  
  540.     '*************************************************************************
  541.     '* SHOW JOYSTICKINFO (HERE WE DO SOME JOYSTICK CALIBRATION)
  542.     '*************************************************************************
  543.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  544.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  545.     DRWSTRING 1, 7, 0, A$, 10, 16
  546.     SETVIEW 0, 0, GETMAXX, GETMAXY
  547.     SELECT CASE JOYSTICK
  548.         CASE IS = 1
  549.             A$ = "Please Move Joystick A As Far As It Will Go In All Directions"
  550.         CASE IS = 2
  551.             A$ = "Please Move Joystick B As Far As It Will Go In All Directions"
  552.         CASE IS = 3
  553.             A$ = "Please Move Both Joystick A And B As Far As They Will Go In All Directions"
  554.     END SELECT
  555.     DRWSTRING 1, 7, 0, A$, 10, 32
  556.     A$ = "And Then Press A Key..."
  557.     DRWSTRING 1, 7, 0, A$, 10, 48
  558.     SOUND 700, .75
  559.     GETMAXXA = -1
  560.     MAXYA = -1
  561.     MINXA = 10000
  562.     MINYA = 10000
  563.     GETMAXXB = -1
  564.     MAXYB = -1
  565.     MINXB = 10000
  566.     MINYB = 10000
  567.     A$ = ""
  568.     WHILE A$ = ""
  569.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  570.         IF JAX > GETMAXXA THEN
  571.             GETMAXXA = JAX
  572.         END IF
  573.         IF JAX < MINXA THEN
  574.             MINXA = JAX
  575.         END IF
  576.         IF JAY > MAXYA THEN
  577.             MAXYA = JAY
  578.         END IF
  579.         IF JAY < MINYA THEN
  580.             MINYA = JAY
  581.         END IF
  582.         IF JBX > GETMAXXB THEN
  583.             GETMAXXB = JBX
  584.         END IF
  585.         IF JBX < MINXB THEN
  586.             MINXB = JBX
  587.         END IF
  588.         IF JBY > MAXYB THEN
  589.             MAXYB = JBY
  590.         END IF
  591.         IF JBY < MINYB THEN
  592.             MINYB = JBY
  593.         END IF
  594.         A$ = INKEY$
  595.     WEND
  596.  
  597.     '*************************************************************************
  598.     '* CALCULATE THE CENTER AND STUFF...
  599.     '*************************************************************************
  600.     SPCNG = GETMAXX \ 7
  601.     DIST = SPCNG * 2
  602.     X1 = SPCNG \ 2
  603.     Y1 = SPCNG \ 2 + 32
  604.     X2 = X1 + DIST
  605.     Y2 = Y1 + DIST
  606.     X4 = GETMAXX - SPCNG
  607.     Y4 = Y2
  608.     X3 = X4 - DIST
  609.     Y3 = Y1
  610.     CNTAX = (X2 - X1) / 2 + X1
  611.     CNTAY = (Y2 - Y1) / 2 + Y1
  612.     CNTBX = (X4 - X3) / 2 + X3
  613.     CNTBY = (Y4 - Y3) / 2 + Y3
  614.     RANGEXA = GETMAXXA - MINXA
  615.     RANGEYA = MAXYA - MINYA
  616.     RANGEXB = GETMAXXB - MINXB
  617.     RANGEYB = MAXYB - MINYB
  618.     JABAX = (X2 - X1) \ 4 + X1 - 16
  619.     JABAY = (SPCNG \ 4) + Y2 - 6
  620.     JABBX = X2 - (X2 - X1) \ 4 - 16
  621.     JABBY = (SPCNG \ 4) + Y2 - 6
  622.     JBBAX = (X4 - X3) \ 4 + X3 - 16
  623.     JBBAY = (SPCNG \ 4) + Y4 - 6
  624.     JBBBX = X4 - (X4 - X3) \ 4 - 16
  625.     JBBBY = (SPCNG \ 4) + Y4 - 6
  626.  
  627.     '*************************************************************************
  628.     '* LETS MOVE IT (OR THEM) AROUND
  629.     '*************************************************************************
  630.     SETVIEW 0, 0, GETMAXX, 64
  631.     FILLVIEW 0
  632.     SETVIEW 0, 0, GETMAXX, GETMAXY
  633.     IF JOYSTICK AND 1 THEN
  634.         DRWBOX 1, 15, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  635.         DRWBOX 1, 15, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  636.         DRWLINE 1, 15, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  637.         OAX = CNTAX
  638.         OAY = CNTAY
  639.         DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  640.     ELSE
  641.         DRWBOX 1, 8, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  642.         DRWBOX 1, 8, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  643.         DRWLINE 1, 8, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  644.     END IF
  645.     IF JOYSTICK AND 2 THEN
  646.         DRWBOX 1, 15, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  647.         DRWBOX 1, 15, X3 - 1, Y4 + 1, X4 + 1, Y4 + SPCNG \ 2
  648.         DRWLINE 1, 15, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  649.         OBX = CNTBX
  650.         OBY = CNTBY
  651.         DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  652.     ELSE
  653.         DRWBOX 1, 8, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  654.         DRWBOX 1, 8, X3 - 1, Y3 + 1, X4 + 1, Y4 + SPCNG \ 2
  655.         DRWLINE 1, 8, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  656.     END IF
  657.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  658.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  659.     DRWSTRING 1, 7, 0, A$, 10, 16
  660.     SETVIEW 0, 32, GETMAXX, GETMAXY
  661.     A$ = ""
  662.     WHILE A$ = ""
  663.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  664.         IF JOYSTICK AND 1 THEN
  665.             SETVIEW X1, Y1, X2, Y2
  666.             JAX = JAX - MINXA
  667.             JAX = JAX / RANGEXA * DIST + X1
  668.             JAY = JAY - MINYA
  669.             JAY = JAY / RANGEYA * DIST + Y1
  670.             DRWLINE 1, 0, CNTAX, CNTAY, OAX, OAY
  671.             OAX = JAX
  672.             OAY = JAY
  673.             DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  674.             SETVIEW 0, 0, GETMAXX, GETMAXY
  675.             IF JAButs AND 1 THEN
  676.                 DRWSTRING 1, 10, 0, "ButA", JABAX, JABAY
  677.             ELSE
  678.                 DRWSTRING 1, 8, 0, "ButA", JABAX, JABAY
  679.             END IF
  680.             IF JAButs AND 2 THEN
  681.                 DRWSTRING 1, 10, 0, "ButB", JABBX, JABBY
  682.             ELSE
  683.                 DRWSTRING 1, 8, 0, "ButB", JABBX, JABBY
  684.             END IF
  685.         END IF
  686.         IF JOYSTICK AND 2 THEN
  687.             SETVIEW X3, Y3, X4, Y4
  688.             JBX = JBX - MINXB
  689.             JBX = JBX / RANGEXB * DIST + X3
  690.             JBY = JBY - MINYB
  691.             JBY = JBY / RANGEYB * DIST + Y3
  692.             DRWLINE 1, 0, CNTBX, CNTBY, OBX, OBY
  693.             OBX = JBX
  694.             OBY = JBY
  695.             DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  696.             SETVIEW 0, 0, GETMAXX, GETMAXY
  697.             IF JBButs AND 1 THEN
  698.                 DRWSTRING 1, 10, 0, "ButA", JBBAX, JBBAY
  699.             ELSE
  700.                 DRWSTRING 1, 8, 0, "ButA", JBBAX, JBBAY
  701.             END IF
  702.             IF JBButs AND 2 THEN
  703.                 DRWSTRING 1, 10, 0, "ButB", JBBBX, JBBBY
  704.             ELSE
  705.                 DRWSTRING 1, 8, 0, "ButB", JBBBX, JBBBY
  706.             END IF
  707.         END IF
  708.         A$ = INKEY$
  709.     WEND
  710.     RET$ = A$
  711.     IF RET$ = "q" THEN
  712.         RET$ = "Q"
  713.     END IF
  714.     IF RET$ = "s" THEN
  715.         RET$ = "S"
  716.     END IF
  717.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  718.         FILLSCREEN (0)
  719.         SETVIEW 0, 0, GETMAXX, GETMAXY
  720.         EXIT SUB
  721.     END IF
  722.  
  723.     SETVIEW 0, 0, GETMAXX, GETMAXY
  724.  
  725.     END SUB
  726.  
  727.     SUB DOMOUSE (RET$)
  728.  
  729.     '*************************************************************************
  730.     '* SET UP THE TITLE
  731.     '*************************************************************************
  732.     TITLE$ = "DEMO 9: Mouse functions"
  733.     FILLSCREEN (0)
  734.     PALSET PAL, 0, 255
  735.     SETVIEW 0, 0, GETMAXX, GETMAXY
  736.  
  737.     '*************************************************************************
  738.     '* CHECK TO SEE IF WE HAVE A MOUSE SO WE CAN DO THE MOUSE DEMO
  739.     '*************************************************************************
  740.     MOUSE = WHICHMOUSE
  741.     IF MOUSE < 1 THEN
  742.         SOUND 100, 5
  743.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  744.         A$ = "Sorry, No Mouse Detected...Can Not Do The Mouse Demo."
  745.         DRWSTRING 1, 7, 0, A$, 10, 16
  746.         WHILE INKEY$ = ""
  747.         WEND
  748.         FILLSCREEN (0)
  749.         EXIT SUB
  750.     ELSE
  751.         Colr = 16
  752.         FOR I = 0 TO GETMAXX \ 2
  753.             DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
  754.             Colr = Colr + 2
  755.             IF Colr > 255 THEN
  756.                 Colr = 16
  757.             END IF
  758.         NEXT I
  759.     END IF
  760.  
  761.     '*************************************************************************
  762.     '* SHOW MOUSESHOW
  763.     '*************************************************************************
  764.     SETVIEW 0, 0, GETMAXX, 31
  765.     FILLVIEW (0)
  766.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  767.     A$ = "MOUSESHOW ()"
  768.     DRWSTRING 1, 7, 0, A$, 10, 16
  769.     SETVIEW 0, 32, GETMAXX, GETMAXY
  770.     MOUSEENTER '*MUST BE CALLED FIRST TO ENABLE MOUSE FUNCTIONS
  771.     MOUSESHOW
  772.     GETKEY RET$
  773.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  774.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  775.         FILLSCREEN (0)
  776.         SETVIEW 0, 0, GETMAXX, GETMAXY
  777.         EXIT SUB
  778.     END IF
  779.  
  780.     '*************************************************************************
  781.     '* SHOW MOUSESTATUS
  782.     '*************************************************************************
  783.     MOUSEHIDE
  784.     SETVIEW 0, 0, GETMAXX, 31
  785.     FILLVIEW (0)
  786.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  787.     A$ = "MOUSESTATUS (Xloc,Yloc,MButs)"
  788.     DRWSTRING 1, 7, 0, A$, 10, 16
  789.     MOUSESHOW
  790.     SETVIEW 0, 32, GETMAXX, GETMAXY
  791.     A$ = ""
  792.     SOUND 700, .75
  793.     WHILE A$ = ""
  794.         MOUSESTATUS X, Y, MButs
  795.         IF MButs AND 1 THEN
  796.             LB = 1
  797.         ELSE
  798.             LB = 0
  799.         END IF
  800.         IF MButs AND 2 THEN
  801.             RB = 1
  802.         ELSE
  803.             RB = 0
  804.         END IF
  805.         IF MButs AND 4 THEN
  806.             CB = 1
  807.         ELSE
  808.             CB = 0
  809.         END IF
  810.         D$ = "X=" + STR$(X)
  811.         L = LEN(D$)
  812.         IF L < 10 THEN
  813.             D$ = D$ + STRING$(8 - L, 32)
  814.         END IF
  815.         D$ = D$ + "Y=" + STR$(Y)
  816.         L = LEN(D$)
  817.         IF L < 20 THEN
  818.             D$ = D$ + STRING$(16 - L, 32)
  819.         END IF
  820.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  821.         DRWSTRING 1, 15, 8, D$, 10, 32
  822.         A$ = INKEY$
  823.     WEND
  824.     RET$ = A$
  825.     IF RET$ = "q" THEN
  826.         RET$ = "Q"
  827.     END IF
  828.     IF RET$ = "s" THEN
  829.         RET$ = "S"
  830.     END IF
  831.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  832.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  833.         FILLSCREEN (0)
  834.         SETVIEW 0, 0, GETMAXX, GETMAXY
  835.         EXIT SUB
  836.     END IF
  837.  
  838.     '*************************************************************************
  839.     '* SHOW MOUSEHIDE
  840.     '*************************************************************************
  841.     MOUSEHIDE
  842.     SETVIEW 0, 0, GETMAXX, 31
  843.     FILLVIEW (0)
  844.     SETVIEW 0, 0, GETMAXX, GETMAXY
  845.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  846.     A$ = "MOUSEHIDE ()"
  847.     DRWSTRING 1, 7, 0, A$, 10, 16
  848.     SETVIEW 0, 32, GETMAXX, GETMAXY
  849.     A$ = ""
  850.     SOUND 700, .75
  851.     WHILE A$ = ""
  852.         MOUSESTATUS X, Y, MButs
  853.         IF MButs AND 1 THEN
  854.             LB = 1
  855.         ELSE
  856.             LB = 0
  857.         END IF
  858.         IF MButs AND 2 THEN
  859.             RB = 1
  860.         ELSE
  861.             RB = 0
  862.         END IF
  863.         IF MButs AND 4 THEN
  864.             CB = 1
  865.         ELSE
  866.             CB = 0
  867.         END IF
  868.         D$ = "X=" + STR$(X)
  869.         L = LEN(D$)
  870.         IF L < 10 THEN
  871.             D$ = D$ + STRING$(8 - L, 32)
  872.         END IF
  873.         D$ = D$ + "Y=" + STR$(Y)
  874.         L = LEN(D$)
  875.         IF L < 20 THEN
  876.             D$ = D$ + STRING$(16 - L, 32)
  877.         END IF
  878.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  879.         DRWSTRING 1, 15, 8, D$, 10, 32
  880.         A$ = INKEY$
  881.     WEND
  882.     MOUSESHOW
  883.     RET$ = A$
  884.     IF RET$ = "q" THEN
  885.         RET$ = "Q"
  886.     END IF
  887.     IF RET$ = "s" THEN
  888.         RET$ = "S"
  889.     END IF
  890.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  891.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  892.         FILLSCREEN (0)
  893.         SETVIEW 0, 0, GETMAXX, GETMAXY
  894.         EXIT SUB
  895.     END IF
  896.  
  897.     '*************************************************************************
  898.     '* SHOW MOUSERANGESET
  899.     '*************************************************************************
  900.     MOUSEHIDE
  901.     SETVIEW 0, 0, GETMAXX, 48
  902.     FILLVIEW (0)
  903.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  904.     A$ = "MOUSERANGESET (X1,Y1,X2,Y2)"
  905.     DRWSTRING 1, 7, 0, A$, 10, 16
  906.     SETVIEW 0, 0, GETMAXX, GETMAXY
  907.     SPCNG = (GETMAXY - 32) \ 3
  908.     X1 = SPCNG
  909.     Y1 = 32 + SPCNG
  910.     X2 = GETMAXX - SPCNG
  911.     Y2 = GETMAXY - SPCNG
  912.     DRWBOX 1, 15, X1, Y1, X2, Y2
  913.     MOUSESHOW
  914.     MOUSERANGESET X1, Y1, X2, Y2
  915.     GETKEY RET$
  916.     MOUSERANGESET 0, 0, GETMAXX, GETMAXY
  917.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  918.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  919.         FILLSCREEN (0)
  920.         SETVIEW 0, 0, GETMAXX, GETMAXY
  921.         EXIT SUB
  922.     END IF
  923.  
  924.  
  925.     '*************************************************************************
  926.     '* SHOW MOUSECURSORSET USE THE MAGNIFIER
  927.     '*************************************************************************
  928.     SETVIEW 0, 0, GETMAXX, 31
  929.     FILLVIEW (0)
  930.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  931.     A$ = "MOUSECURSORSET (XHotSpot,YHotSpot,MouseCursor$)"
  932.     DRWSTRING 1, 7, 0, A$, 10, 16
  933.     SETVIEW 0, 32, GETMAXX, GETMAXY
  934.     MOUSECURSORSET MAGMOUSECURSOR
  935.     GETKEY RET$
  936.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  937.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  938.         FILLSCREEN (0)
  939.         SETVIEW 0, 0, GETMAXX, GETMAXY
  940.         EXIT SUB
  941.     END IF
  942.  
  943.     '*************************************************************************
  944.     '* SHOW MOUSECURSORSET USE THE BIG ARROW
  945.     '*************************************************************************
  946.     SETVIEW 0, 32, GETMAXX, GETMAXY
  947.     MOUSECURSORSET BIGMOUSECURSOR
  948.     GETKEY RET$
  949.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  950.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  951.         FILLSCREEN (0)
  952.         SETVIEW 0, 0, GETMAXX, GETMAXY
  953.         EXIT SUB
  954.     END IF
  955.  
  956.     '*************************************************************************
  957.     '* SHOW MOUSECURSORSET USE THE STOPWATCH
  958.     '*************************************************************************
  959.     MOUSECURSORSET STWMOUSECURSOR
  960.     GETKEY RET$
  961.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  962.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  963.         FILLSCREEN (0)
  964.         SETVIEW 0, 0, GETMAXX, GETMAXY
  965.         EXIT SUB
  966.     END IF
  967.  
  968.     '*************************************************************************
  969.     '* SHOW MOUSECURSORDEFAULT
  970.     '*************************************************************************
  971.     MOUSEHIDE
  972.     SETVIEW 0, 0, GETMAXX, 31
  973.     FILLVIEW (0)
  974.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  975.     A$ = "MOUSECURSORDEFAULT ()"
  976.     DRWSTRING 1, 7, 0, A$, 10, 16
  977.     MOUSESHOW
  978.     SETVIEW 0, 32, GETMAXX, GETMAXY
  979.     MOUSECURSORDEFAULT
  980.     GETKEY RET$
  981.     MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  982.     FILLSCREEN (0)
  983.     SETVIEW 0, 0, GETMAXX, GETMAXY
  984.  
  985.     END SUB
  986.  
  987.     SUB SHOWGIF (RET$, FILENAME$)
  988.  
  989.  
  990.     '*************************************************************************
  991.     '* THIS ROUTINE IS CALLED BY DOGIF
  992.     '*************************************************************************
  993.     TITLE$ = "DEMO 8: GIF functions"
  994.  
  995.     '*************************************************************************
  996.     '* SHOW GIF GET INFO
  997.     '*************************************************************************
  998.     FILLSCREEN (0)
  999.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  1000.     A$ = "GIFGETINFO(FileName$,GifXSize,GifYSize,NumColors,Palette$)"
  1001.     DRWSTRING 1, 7, 0, A$, 10, 16
  1002.     GIFFILENAME$ = FILENAME$
  1003.     OK = GIFGETINFO(GIFFILENAME$, XSIZE, YSIZE, NUMCOL, GIFPAL)
  1004.     MIN = 255
  1005.     MAX = 0
  1006.     IF OK = 1 THEN
  1007.         '*********************************************************************
  1008.         '* WE NEED TO CHECK THE GIF COLOR PALETTE ENTRIES TO SEE IF ANY COLORS
  1009.         '* ARE GREATER THE SIX BITS IN LENGTH AS THE VGA COLOR PALETTE
  1010.         '* REGISTERS ARE ONLY SIX BITS WIDE. WE ALSO LOOK FOR THE BRIGHTEST
  1011.         '* AND DARKEST COLORS TO USE AS OUR TEXT AND BACKGROUND COLORS
  1012.         '*********************************************************************
  1013.         FIXIT = 0
  1014.         FOR A = 1 TO NUMCOL * 3 STEP 3
  1015.             R = ASC(MID$(GIFPAL, A, 1))
  1016.             G = ASC(MID$(GIFPAL, A + 1, 1))
  1017.             B = ASC(MID$(GIFPAL, A + 2, 1))
  1018.             IF R > 63 THEN
  1019.                 FIXIT = 1
  1020.             END IF
  1021.             IF G > 63 THEN
  1022.                 FIXIT = 1
  1023.             END IF
  1024.             IF B > 63 THEN
  1025.                 FIXIT = 1
  1026.             END IF
  1027.             TEST = R + G + B
  1028.             IF TEST < MIN THEN  '* FIND THE DARKEST COLOR FOR THE BACKGROUND
  1029.                 MIN = TEST
  1030.                 MINCOLOR = A / 3
  1031.             END IF
  1032.             IF TEST > MAX THEN
  1033.                 MAX = TEST      '* FIND THE BRIGHTEST COLOR FOR THE TEXT
  1034.                 MAXCOLOR = A / 3
  1035.             END IF
  1036.         NEXT A
  1037.         '*********************************************************************
  1038.         '* IF THE GIF USES 8 BIT COLOR THEN WE SHIFT EACH COLOR ENTRY RIGHT
  1039.         '* BY 2 BITS (THIS REDUCES IT TO 6 BITS OF COLOR)
  1040.         '*********************************************************************
  1041.         IF FIXIT = 1 THEN
  1042.             FOR A = 1 TO NUMCOL * 3
  1043.                 C = ASC(MID$(GIFPAL, A, 1))
  1044.                 MID$(GIFPAL, A, 1) = CHR$(C \ 4)
  1045.             NEXT A
  1046.         END IF
  1047.         '*********************************************************************
  1048.         '* IF THE GIF HAS A PALETTE OF 128 COLORS OR LESS THEN WE CAN USE
  1049.         '* OUR OWN COLORS FOR THE TEXT AND BACKGROUND
  1050.         '*********************************************************************
  1051.         IF NUMCOL < 128 THEN
  1052.             MID$(GIFPAL, 763, 1) = CHR$(0)  '* THIS IS THE COLOR BLACK
  1053.             MID$(GIFPAL, 764, 1) = CHR$(0)
  1054.             MID$(GIFPAL, 765, 1) = CHR$(0)
  1055.             MINCOLOR = 254
  1056.             MID$(GIFPAL, 766, 1) = CHR$(32) '* THIS IS THE COLOR MED WHITE
  1057.             MID$(GIFPAL, 767, 1) = CHR$(32)
  1058.             MID$(GIFPAL, 768, 1) = CHR$(32)
  1059.             MAXCOLOR = 255
  1060.         END IF
  1061.  
  1062.         A$ = "'" + GIFFILENAME$ + "' is identified as a 'Non-Interlaced' type 'GIF87a' GIF."
  1063.         DRWSTRING 1, 15, 0, A$, 10, 64
  1064.         A$ = "Dimensions are:" + STR$(XSIZE) + " pixels wide and" + STR$(YSIZE) + " pixels high"
  1065.         DRWSTRING 1, 15, 0, A$, 10, 80
  1066.         A$ = "Number of colors:" + STR$(NUMCOL)
  1067.         DRWSTRING 1, 15, 0, A$, 10, 96
  1068.  
  1069.         GETKEY RET$
  1070.         IF (RET$ = "S") OR (RET$ = "Q") THEN
  1071.             FILLSCREEN (0)
  1072.             SETVIEW 0, 0, GETMAXX, GETMAXY
  1073.             EXIT SUB
  1074.         END IF
  1075.  
  1076.         '*********************************************************************
  1077.         '* SHOW GIF GET PUT
  1078.         '*********************************************************************
  1079.         PALSET GIFPAL, 0, 255
  1080.         OVERSCANSET (MINCOLOR)
  1081.         FILLSCREEN (MINCOLOR)
  1082.         DRWSTRING 1, MAXCOLOR, MINCOLOR, TITLE$, 10, 0
  1083.         A$ = "GIFPUT(Mode,X,Y,FileName$)"
  1084.         DRWSTRING 1, MAXCOLOR, MINCOLOR, A$, 10, 16
  1085.         SETVIEW 0, 32, GETMAXX, GETMAXY
  1086.         Xloc = (GETMAXX \ 2) - (XSIZE \ 2)
  1087.         Yloc = ((GETMAXY - 32) \ 2) - (YSIZE \ 2) + 32
  1088.         OK = GIFPUT(1, Xloc, Yloc, GIFFILENAME$)
  1089.         IF OK <> 1 THEN
  1090.         '*********************************************************************
  1091.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1092.         '********************************************************************
  1093.             SOUND 100, 5
  1094.             A$ = "The file '" + GIFFILENAME$ + "' "
  1095.             B$ = ""
  1096.             SELECT CASE OK
  1097.                 CASE IS = 0
  1098.                     A$ = A$ + "does not exist in the specified directory"
  1099.                     B$ = " or there is some disk I/O problem."
  1100.                 CASE IS = -1
  1101.                     A$ = A$ + "does not have the 'GIF87a' signature."
  1102.                 CASE IS = -2
  1103.                     A$ = A$ + "is an interlaced GIF."
  1104.                 CASE IS = -3
  1105.                     A$ = A$ + "does not use a global color map."
  1106.                 CASE IS = -4
  1107.                     A$ = A$ + "has some general error."
  1108.             END SELECT
  1109.             DRWSTRING 1, MINCOLOR, MAXCOLOR, A$, 10, 64
  1110.             DRWSTRING 1, MINCOLOR, MAXCOLOR, B$, 10, 80
  1111.         END IF
  1112.     ELSE
  1113.         '*********************************************************************
  1114.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1115.         '*********************************************************************
  1116.         SOUND 100, 5
  1117.         A$ = "The file '" + GIFFILENAME$ + "' "
  1118.         B$ = ""
  1119.         SELECT CASE OK
  1120.             CASE IS = 0
  1121.                 A$ = A$ + "does not exist in the specified directory"
  1122.                 B$ = " or there is some disk I/O problem."
  1123.             CASE IS = -1
  1124.                 A$ = A$ + "does not have the 'GIF87a' signature."
  1125.             CASE IS = -2
  1126.                 A$ = A$ + "is an interlaced GIF."
  1127.             CASE IS = -3
  1128.                 A$ = A$ + "does not use a global color map."
  1129.             CASE IS = -4
  1130.                 A$ = A$ + "has some general error."
  1131.         END SELECT
  1132.         DRWSTRING 1, 15, 0, A$, 10, 64
  1133.         DRWSTRING 1, 15, 0, B$, 10, 80
  1134.     END IF
  1135.     GETKEY RET$
  1136.     PALSET ORGPAL, 0, 255
  1137.     OVERSCANSET (0)
  1138.     FILLSCREEN (0)
  1139.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1140.  
  1141.     END SUB
  1142.  
  1143.     SUB SHOWHOUSE
  1144.  
  1145.     SHARED OPLOTARRY() AS P2DType
  1146.     SHARED PLOTARRY() AS P2DType
  1147.  
  1148.     '*************************************************************************
  1149.     '* THIS ROUTINE IS CALLED BY DO3D
  1150.     '*************************************************************************
  1151.  
  1152.     '*************************************************************************
  1153.     '* ERASE THE OLD HOUSE
  1154.     '*************************************************************************
  1155.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(11).X, OPLOTARRY(11).Y
  1156.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(12).X, OPLOTARRY(12).Y
  1157.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(13).X, OPLOTARRY(13).Y
  1158.     FOR I = 0 TO 2
  1159.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1160.         DRWLINE 1, 0, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y, OPLOTARRY(I + 4 + 1).X, OPLOTARRY(I + 4 + 1).Y
  1161.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y
  1162.     NEXT I
  1163.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1164.     DRWLINE 1, 0, OPLOTARRY(0).X, OPLOTARRY(0).Y, OPLOTARRY(3).X, OPLOTARRY(3).Y
  1165.     DRWLINE 1, 0, OPLOTARRY(4).X, OPLOTARRY(4).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1166.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(8).X, OPLOTARRY(8).Y
  1167.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(2).X, OPLOTARRY(2).Y
  1168.     DRWLINE 1, 0, OPLOTARRY(7).X, OPLOTARRY(7).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1169.     DRWLINE 1, 0, OPLOTARRY(9).X, OPLOTARRY(9).Y, OPLOTARRY(6).X, OPLOTARRY(6).Y
  1170.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1171.  
  1172.     '*************************************************************************
  1173.     '* DRAW THE NEW HOUSE
  1174.     '*************************************************************************
  1175.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(11).X, PLOTARRY(11).Y
  1176.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(12).X, PLOTARRY(12).Y
  1177.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(13).X, PLOTARRY(13).Y
  1178.     FOR I = 0 TO 2
  1179.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1180.         DRWLINE 1, 10, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y, PLOTARRY(I + 4 + 1).X, PLOTARRY(I + 4 + 1).Y
  1181.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y
  1182.     NEXT I
  1183.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1184.     DRWLINE 1, 10, PLOTARRY(0).X, PLOTARRY(0).Y, PLOTARRY(3).X, PLOTARRY(3).Y
  1185.     DRWLINE 1, 10, PLOTARRY(4).X, PLOTARRY(4).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1186.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(8).X, PLOTARRY(8).Y
  1187.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(2).X, PLOTARRY(2).Y
  1188.     DRWLINE 1, 10, PLOTARRY(7).X, PLOTARRY(7).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1189.     DRWLINE 1, 10, PLOTARRY(9).X, PLOTARRY(9).Y, PLOTARRY(6).X, PLOTARRY(6).Y
  1190.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1191.  
  1192.     '*************************************************************************
  1193.     '* SAVE THE OLD POINTS
  1194.     '*************************************************************************
  1195.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  1196.  
  1197.     END SUB
  1198.  
  1199.     SUB SHOWSTAR
  1200.  
  1201.     SHARED OPLOTARRY() AS P2DType
  1202.     SHARED PLOTARRY() AS P2DType
  1203.  
  1204.     '*************************************************************************
  1205.     '* THIS ROUTINE IS CALLED BY DO2D
  1206.     '*************************************************************************
  1207.  
  1208.     '*************************************************************************
  1209.     '* ERASE THE OLD STAR
  1210.     '*************************************************************************
  1211.     FOR I = 0 TO 7
  1212.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1213.     NEXT I
  1214.  
  1215.     '*************************************************************************
  1216.     '* DRAW THE NEW STAR
  1217.     '*************************************************************************
  1218.     FOR I = 0 TO 7
  1219.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1220.     NEXT I
  1221.  
  1222.     '*************************************************************************
  1223.     '* SAVE THE OLD POINTS
  1224.     '*************************************************************************
  1225.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 36
  1226.  
  1227.     END SUB
  1228.  
  1229.